perm filename CHOSPT.SAI[S,HE] blob
sn#726729 filedate 1983-10-27 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY CHOSPTS,INITOVERLAY,OVERLINE,FINIOVERLAY,SETLEFT,SETRIGHT,TESTOVERS
C00022 00003 α Start of ADJPIC code
C00041 00004 INTERNAL PROCEDURE CHOSPTS(REFERENCE REAL ARRAY LX,LY,RX,RY
C00051 ENDMK
C⊗;
ENTRY CHOSPTS,INITOVERLAY,OVERLINE,FINIOVERLAY,SETLEFT,SETRIGHT,TESTOVERS;
BEGIN "CHOSPTS"
Comment This procedure puts two pictures up on Grinnell channels,
allow the user to choose some spot on the right image (with
crosshairs) and then locate a corresponding spot on the left
image. Refinement of the match (will give) gives a pair of coords.
This is repeated until user says fini with a `l'.;
REQUIRE "16A" COMPILER_SWITCHES; comment FIXR,FLTR,ADJSP;
DEFINE π="3.141592653";
DEFINE UNLESS="WHILE ¬";
DEFINE α="COMMENT ";
DEFINE THRU="STEP 1 UNTIL";
DEFINE TAB="'11";
DEFINE LF="'12";
DEFINE CRLF="'15&'12";
DEFINE CCRLF="&'15&'12";
DEFINE GRIGHT=TRUE, GLEFT=FALSE;
DEFINE VIDEOCHAN=4;
DEFINE INFINITY='377777777777;
REQUIRE "VIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "GRNHDR.SAI[HDR,HE]" SOURCE_FILE;
α Grinnel function routines;
REQUIRE "CRDHDR.SAI[HDR,HE]" SOURCE_FILE;
α Definitions for Grinnel;
REQUIRE "GRNDEF[HDR,HE]" SOURCE_FILE;
α Direct grinnell graphics;
REQUIRE "GFNHDR.SAI[HDR,HE]" SOURCE_FILE;
REQUIRE "DDSIM[S,HE]" LIBRARY;
REQUIRE "INTERD.HDR[S,HHB]" SOURCE_FILE;
EXTERNAL PROCEDURE GTXTPS(REAL X,Y,XS,YS,DXS(0),DYS(0));
EXTERNAL PROCEDURE GTEXT(STRING TXT);
EXTERNAL PROCEDURE GSCREN(REAL XLO,YLO,XHI,YHI);
DEFINE ZCONTROL=BLANKING;
DEFINE CURSNUM=1;
DEFINE ZSET=TRUE;
DEFINE NOHZ=1,NOVT=2;
DEFINE CTLV="QUICK_CODE '047000400001; END;";
DEFINE RIGHT=0,LEFT=1;
DEFINE VIDSCR='44; α video channel visible through vds;
DEFINE MAXPTS=20; α NOTE: dimensions of LX, etc = 1:20;
DEFINE DDPORT=1; α THIS REFERS TO THE PORT OUTPUT ... 1 - 6, not 0-5;
DEFINE MASKWID=3,TMPWID=3,SDF←0,FOURWID=3,IRATIO=1;
INTEGER LCRSX,LCRSY,RCRSX,RCRSY,RZMULT,LZMULT,XCOORD,YCOORD,
LLX,LLY,LRX,LRY,LCX,LCY,RLX,RLY,RRX,RRY,RCX,RCY,
LPCLGT,LPCWID,RPCWID,RPCLGT,XMOVE,YMOVE,RZFCTR,LZFCTR,
GRNLEFT,GRNTOP,GRNBOT,RZX,RZY,LZX,LZY,PICLGT,PICWID,BITS;
REAL SA,SB,SC,FLAT,XV,YV,SXX,SYY,SXY,P;
BOOLEAN BFLAG;
REAL ARRAY SLX,SLY,SRX,SRY,NRX,NRY[1:MAXPTS]; α points;
REAL ARRAY RES[1:6];
INTEGER I,J,K,NUMPTS,LX,LY,RX,RY,LBASX,RBASX;
INTEGER LOVERLAY,ROVERLAY;
INTEGER ZSCAL,TZSCAL,CINCR,DOING;
INTEGER CRSX,CRSY,HEIGHT,WIDTH;
INTEGER LCH,RCH,PORT,LSIZE,RSIZE,DRIVER,CHAN,OVERLAY,FILECHAN,DPBRCHAR,DPEOF,DPFLAG;
INTEGER CHAR,BIGSIZ;
INTEGER ARRAY L[1:6],R[1:6],DD[1:3]; α video outputs;
BOOLEAN MIDCURSOR,CURBLINK,PANSETTING,POSSET,DDVDIR,TWOSCRS,OLDPTS,CONRAC;
REAL M11,M12,M13,M21,M22,M23,M31,M32,M33,
MINV11,MINV12,MINV13,MINV21,MINV22,MINV23,MINV31,MINV32,MINV33,
BX,BY;
STRING PICL,PICR;
PROCEDURE GETD(REFERENCE INTEGER NUM; STRING QUESTION; INTEGER DEFAULT);
Begin "GETD"
PRINT(QUESTION);
PTOSTR(0,CVS(DEFAULT));
NUM ← CVD(INCHWL)
End "GETD";
PROCEDURE GETO(REFERENCE INTEGER NUM; STRING QUESTION; INTEGER DEFAULT);
Begin "GETO"
PRINT(QUESTION);
PTOSTR(0,CVOS(DEFAULT));
NUM ← CVO(INCHWL)
End "GETO";
INTEGER PROCEDURE GETANSWER;
Begin INTEGER ANS; ANS←INCHRW LAND '137; PRINT(CRLF); RETURN(ANS) End;
BOOLEAN PROCEDURE ASK(STRING QUESTION); α ask a yes/no question;
Begin "ask"
INTEGER ASK;
DO BEGIN print(question,"(Y or N)? ");
ask←getanswer;
END UNTIL ask="Y" ∨ ask="N";
return(if ask="Y" then TRUE else FALSE)
End "ask";
PROCEDURE GSHOW(INTEGER GCHANSHOW);
Begin "make port show channel"
IF GCHANSHOW = LCH THEN
Begin
SWITCHCHAN(0,L[1],L[2],L[3]);
SWITCHCHAN(1,L[4],L[5],L[6]);
End
ELSE
Begin
SWITCHCHAN(0,R[1],R[2],R[3]);
SWITCHCHAN(1,R[4],R[5],R[6]);
End;
End "make port show channel";
PROCEDURE GSETUP;
Begin "gsetup"
SwitchChan(0,0,1,2);
SwitchChan(1,1,2,3);
ZOOM_PAN(0,0,255,255,BLANKING); α unzoom all channels;
ZOOM_PAN(1,0,255,255,BLANKING);
ZOOM_PAN(2,0,255,255,BLANKING);
ZOOM_PAN(3,0,255,255,BLANKING);
ERASEG(LCH);ERASEG(RCH);
GSHOW_CURSOR(0,0);
IFVCOUTPUT(0,0,0,0,0); α set up no overlays;
IFVCOUTPUT(1,0,0,0,0); α set up no overlays;
MAPGRN(0,0,8);MAPGRN(0,1,8);MAPGRN(0,2,8); α all 8 bits;
MAPGRN(1,0,8);MAPGRN(1,1,8);MAPGRN(1,2,8);
End "gsetup";
PROCEDURE DRAWGRNLINE(INTEGER X1,Y1,X2,Y2; INTEGER bitmask('7777));
α This Procedure draws a vector on the Grinnell
between the pixels (x1,y1) and (x2,y2);
BEGIN "GrnLine"
REAL M,A,B,C,D;
M←(Y2-Y1)/(X2-X1);B←Y2-M*X2;A←X2-Y2/M;
C←(511-B)/M;D←511*M+B;
IF X1<0 THEN Begin y1←b;x1←0;End ELSE
IF X1>511 THEN Begin x1←511;y1←d;End;
IF X2<0 THEN Begin y2←b;x2←0;End ELSE
IF X2>511 THEN Begin x2←511;y2←d;End;
IF Y1<0 THEN Begin x1←a;y1←0;End ELSE
IF Y1>511 THEN Begin y1←511;x1←c;End;
IF Y2<0 THEN Begin x2←a;y2←0;End ELSE
IF Y2>511 THEN Begin y2←511;x2←c;End;
GrnIns(LSM LOR '7777); α Enable the bits to be erased;
GrnIns(LWM LOR BITV LOR BITB); α Vector drawing, dark line;
GrnIns(LUM LOR L1 LOR E1); α Set updating;
GrnIns(LLA LOR (y1 LAND '777)); α Load line reg A with line number;
GrnIns(LEA LOR (x1 LAND '777)); α Load element reg A w/element #;
GrnIns(LLB LOR ((y2-y1) LAND '777)); α Vectors are drawn between (Ea,La);
GrnIns(LEB LOR ((x2-x1) LAND '777) LOR WBIT); α and (Ea+Eb,La+Lb);
GrnIns(LSM LOR (bitmask LAND '7777)); α Enable the bits to be written;
GrnIns(LWM LOR BITV); α Vector drawing, light line, ADDITIVE;
GrnIns(LLA LOR (y1 LAND '777)); α Load line reg A with line number;
GrnIns(LEA LOR (x1 LAND '777)); α Load element reg A w/element #;
GrnIns(LLB LOR ((y2-y1) LAND '777)); α Vectors are drawn between (Ea,La);
GrnIns(LEB LOR ((x2-x1) LAND '777) LOR WBIT); α and (Ea+Eb,La+Lb);
END "GrnLine";
PROCEDURE DOZOOM(INTEGER ZDIR; BOOLEAN ZOOMSET);
Begin "zooming"
IF ZOOMSET THEN Begin IF DOING=RIGHT THEN RZFCTR←0 ELSE LZFCTR←0 End;
IF (ZDIR ≠ 0) or ZOOMSET THEN
Begin
IF DOING=RIGHT THEN
Begin "right image"
RZX←256;RZY←256;
RZFCTR←((RZFCTR+ZDIR) MAX 0) MIN 3;
RZMULT←2↑RZFCTR;IF MIDCURSOR THEN CINCR←RZMULT DIV 2;
GABS_SET_CURSOR(CURSNUM,RZX-CINCR,RZY-CINCR);
ZOOM_PAN(RCH,RZFCTR,GRNLEFT+RCRSX,GRNBOT+RCRSY,ZCONTROL);
End "right image"
ELSE
Begin "left image"
LZX←256;LZY←256;
LZFCTR←((LZFCTR+ZDIR) MAX 0) MIN 3;
LZMULT←2↑LZFCTR;IF MIDCURSOR THEN CINCR←LZMULT DIV 2;
GABS_SET_CURSOR(CURSNUM,LZX-CINCR,LZY-CINCR);
ZOOM_PAN(LCH,LZFCTR,GRNLEFT+LCRSX,GRNBOT+LCRSY,ZCONTROL);
End "left image"
End;
BUFOUT;
End "zooming";
PROCEDURE CRSHRS(INTEGER TX,TY);
Begin "crosshairs"
IF DOING=RIGHT THEN
Begin "rcrs"
RZX←RZX+TX*RZMULT;RZY←RZY+TY*RZMULT;IF MIDCURSOR THEN CINCR←RZMULT DIV 2;
GABS_SET_CURSOR(CURSNUM,RZX-CINCR,RZY-CINCR);
End "rcrs"
ELSE
Begin "lcrs"
LZX←LZX+TX*LZMULT;LZY←LZY+TY*LZMULT;IF MIDCURSOR THEN CINCR←LZMULT DIV 2;
GABS_SET_CURSOR(CURSNUM,LZX-CINCR,LZY-CINCR);
End "lcrs"
End "crosshairs";
PROCEDURE SELECT(INTEGER CHAN);
Begin "select"
GRNINS(LDC LOR (1 LSH CHAN));
GRNINS(LSM LOR '7777); α CHAN AND ALL BITS;
End "select";
PROCEDURE RISHOW; α get Right screen showing;
Begin "show right screen"
SELECT(RCH);
DOING←RIGHT;
CRSHRS(0,0);
GSHOW(RCH);
BUFOUT;
END "show right screen";
PROCEDURE LISHOW; α get Left screen showing;
Begin "show left screen"
SELECT(LCH);
DOING←LEFT;
CRSHRS(0,0);
GSHOW(LCH);
BUFOUT;
END "show left screen";
PROCEDURE STARTLOC;
Begin "initialize screens"
IF DOING=LEFT THEN
Begin
IF POSSET THEN
Begin LCRSX←XCOORD;LCRSY←YCOORD; End
ELSE
Begin LCRSX←(LPCWID-1)/2;LCRSY←(LPCLGT-1)/2; End;
SELECT(LCH);DOZOOM(ZSCAL,ZSET);
End;
IF DOING=RIGHT THEN
Begin
IF POSSET THEN
Begin RCRSX←XCOORD;RCRSY←YCOORD; End
ELSE
Begin RCRSX←(RPCWID-1)/2;RCRSY←(RPCLGT-1)/2; End;
SELECT(RCH);DOZOOM(ZSCAL,ZSET);
End;
End "initialize screens";
PROCEDURE HELP; α listing of what to do;
Begin "help"
CTLV; α echo;
IF DDVDIR THEN SHOW(-1,-1);
PRINT("Commands:
uio = up (left, straight, right)
jk = left, right
nm, = down (left, straight, right)
+-* = zoom (in, out, reset)
p = toggle for panning
<sp> = space - look at other image
. = take this point
l = DONE everything
<shift> uses large increments
<meta> is continuous
? = this listing
");
IF DDVDIR THEN ASK("Continue"); α DD versus DIRECT;
CTLV; α echo off again;
IF DDVDIR THEN SHOW(VIDSCR,-1);
End "help";
PROCEDURE LOCLOP(REFERENCE INTEGER TX,TY;REFERENCE BOOLEAN LEAVE);
Begin "crosshair manipulation"
DEFINE SNEAKW='047000400063;
DEFINE TTREAD='051700000000;
DEFINE INCHGT='051000000000;
DEFINE c_a='1,c_b='2,c_d='4,c_e='5,c_g='7,c_i='11,c_j='12,c_k='13,
c_l='14,c_m='15,c_n='16,c_o='17,c_p='20,c_q='21,c_s='23,c_u='25,
c_v='26,c_w='27,c_x='30,c_z='32,c_space='40,c_times='52,c_plus='53,
c_comma='54,c_minus='55,c_dot='56,c_0='60,c_1='61,c_colon='72;
INTEGER SIZE,SIZE2,CHAR,BITS; BOOLEAN SHIFT,META,TOP;
COMMENT now allow the user to specify up,down,left,right, or back (reverse
direction), looping until a <cr> is hit . Then exit. Each keystroke
is received immediately, without having to do a <cr> ;
PROCEDURE SWPVUL;
Begin "Show other screen until a <sp> is hit"
IF DOING=RIGHT THEN LISHOW ELSE RISHOW;
DO CHAR←INCHRW UNTIL CHAR = " "; α wait for <sp>;
IF DOING=RIGHT THEN LISHOW ELSE RISHOW;
End "Show other screen until a <sp> is hit";
PICLGT←IF DOING=RIGHT THEN RPCLGT ELSE LPCLGT;
META←FALSE;
PANSETTING←LEFT;SELECT(if DOING=RIGHT then RCH else LCH);
WHILE true DO BEGIN "positioning loop"
integer cmd;
bits←-1;
START_CODE
SKIPN META; α if meta last time, dont wait for char;
SNEAKW 1,; α wait for a char to be ready;
TTREAD BITS; α get keyboard bits;
SKIPN META;
INCHGT CHAR; α get the character;
END;
IF (BITS LAND '1000) = 0 THEN META←TRUE ELSE META←FALSE;
IF (BITS LAND '200) = 0 THEN TOP←TRUE ELSE TOP←FALSE;
IF (BITS LAND '100) = 0 THEN SHIFT←TRUE ELSE SHIFT←FALSE;
CMD←BITS LAND '77; α six bits of command;
IF CMD = 0 THEN META←FALSE;
LEAVE←FALSE; XMOVE←YMOVE←0;
size ←(IF SHIFT THEN BIGSIZ ELSE 1);
α lowercase letters indicate small steps,
uppercase large ones;
size2 ←(IF SHIFT THEN 2 ELSE 1); α double for shift;
case cmd of
begin "case"
[c_u] begin ymove←size;xmove←-size;end; α up and left;
[c_i] ymove←size; α up;
[c_o] begin ymove←size;xmove←size;end; α up and right;
[c_j] xmove←-size; α left;
[c_k] xmove←size; α right;
[c_n] begin ymove←-size;xmove←-size;end; α down and left;
[c_m] ymove←-size; α down;
[c_space] SWPVUL; α swap to other image;
[c_comma] begin ymove←-size;xmove←size;end; α down and right;
[c_plus] DOZOOM(+1,¬ZSET); α zoom in;
[c_minus] DOZOOM(-1,¬ZSET); α zoom out;
[c_times] STARTLOC; α centre at normal zoom;
[c_p] PANSETTING←¬PANSETTING; α flip status of pan;
[c_l] Begin LEAVE←TRUE;DONE;END;α leave screen zoomed;
[c_dot] if TOP then HELP else DONE; α all done or help;
[c_colon] PRINT("(",TX,",",PICLGT-TY,")"); α give coordinates;
else α nothing reasonable;
end "case";
TX←TX+XMOVE;TY←TY+YMOVE;
CRSHRS(XMOVE,YMOVE); α draw cross-hairs;
IF PANSETTING THEN DOZOOM(IF DOING=RIGHT THEN RZFCTR ELSE LZFCTR,ZSET);
BUFOUT;
END "positioning loop";
GSHOW_CURSOR(0,0);
End "crosshair manipulation";
α Start of ADJPIC code;
PROCEDURE ADJPIC;
Begin "Lining up two pairs of points for ROTCROP"
INTEGER ARRAY PICARRAY[0:LSIZE-1];
PROCEDURE LABELPIC(STRING TXTSTR);
Begin "Put text where image ended"
GTXTPS(GRNLEFT,GRNBOT,0,0,10,10);
GTEXT(TXTSTR); α label picture;
BUFOUT;
End "Put text where image ended";
PROCEDURE LSETUP;
Begin "loading Lpicture parameters"
GSCREN(0,0,511,511); α normal Grinnel screen;
LPCWID←PICARRAY[LNBY]; LPCLGT←PICARRAY[PCLN]; α Left image size;
BITS←PICARRAY[BYBI]; α keep bits per byte of images;
BIGSIZ←10; α big space moving in crosshairs;
GRNLEFT←(512-LPCWID)/2;
GRNTOP←255+LPCLGT/2;
GRNBOT←GRNTOP-LPCLGT+1;
End "loading Lpicture parameters";
PROCEDURE RSETUP;
Begin "loading Rpicture parameters"
RPCWID←PICARRAY[LNBY]; RPCLGT←PICARRAY[PCLN]; α Right image size;
End "loading Rpicture parameters";
PROCEDURE LPICUP;
Begin "put up Lpicture"
INTEGER PROCEDURE POWEROF(INTEGER NUM);
Begin "jffo code"
LABEL HVCNT;
START_CODE
DEFINE SC0=0, SC1=1;
MOVE SC0,NUM; α see how many bits to shift;
JFFO SC0,HVCNT;
MOVEI SC1,35;
HVCNT: MOVNI SC1,-35(SC1);
HRRZS SC1;
END;
End "jffo code";
ZSCAL←POWEROF(512 DIV LPCWID);
DOING←LEFT;ERASEG(LCH);
VIDGRN(GRNLEFT,GRNTOP,LCH,PICARRAY,8-PICARRAY[BYBI]);
LABELPIC("Left"); α label picture;
BUFOUT;
GSHOW(LCH);
End "put up Lpicture";
PROCEDURE RPICUP;
Begin "put up Rpicture"
DOING←RIGHT;ERASEG(RCH);
VIDGRN(GRNLEFT,GRNTOP,RCH,PICARRAY,8-PICARRAY[BYBI]);
LABELPIC("Right"); α label picture;
BUFOUT;
GSHOW(RCH);
End "put up Rpicture";
PROCEDURE IMPROVE; α improve of correspondence estimates from CHOSPT run;
Begin "improve"
INTEGER ARRAY LINARR,RINARR[1:100,1:5];
GETPFL(PICL,PICARRAY[0]); α bring in Left picture;
SETFORMAT(7,4); α not very high precision;
FOR I←1 THRU numpts DO
Begin "ptlsin"
LX←SLX[I];LY←SLY[I];
LBASX←(I-1)*3+2;
FOR J←-1 THRU 1 DO α 3 by 3 window;
FOR K←-1 THRU 1 DO
LINARR[LBASX+J,K+2]←PIXEL(PICARRAY[0],LX+K,LY+J);
End "ptlsin";
GETPFL(PICR,PICARRAY[0]); α bring in Right picture;
FOR I←1 THRU numpts DO
Begin "ptrsin"
RX←SRX[I];RY←SRY[I];
RBASX←(I-1)*5+3;
FOR J←-2 THRU 2 DO α 5 by 5 window;
FOR K←-2 THRU 2 DO
RINARR[RBASX+J,K+3]←PIXEL(PICARRAY[0],RX+K,RY+J);
End "ptrsin";
SA←1.0;SB←0;SC←0;FLAT←0;
α OUTSTR("Left Right Original/Improved points:"&crlf);
FOR I←1 THRU numpts DO
Begin "mprv"
RBASX←(I-1)*5+3;LBASX←(I-1)*3+2;
SMATCH(LINARR,RINARR,LBASX,2,RBASX,3,
MASKWID,TMPWID,FOURWID,IRATIO,SDF,SA,SB,SC,FLAT,
XV,YV,SXX,SYY,SXY,P,RES,BFLAG);
NRX[I]←SRX[I]+(XV-(3+(I-1)*5));NRY[I]←SRY[I]+(YV-3);
α PRINT("(",cvf(SLX[I]),",",cvf(SLY[I]),") (",cvf(SRX[I]),",",cvf(SRY[I]),
" / ",cvf(NRX[I]),",",cvf(NRY[I]),")",CRLF);
SRX[I]←NRX[I];SRY[I]←NRY[I];
End "mprv";
End "improve";
BOOLEAN PROCEDURE AD(BOOLEAN SIDE);
Begin "fiddling with crosshairs"
CTLV; α echo off;
IF SIDE = GRIGHT THEN
Begin "do Right image crosshair adjustment"
DOING←RIGHT;SELECT(RCH);
RZX←(GRNLEFT+RCRSX-256)*RZMULT+256;
RZY←(GRNBOT+RCRSY-256)*RZMULT+256;
GSHOW_CURSOR(CURSNUM, IF CURBLINK THEN CURSNUM ELSE 0);
CRSHRS(0,0);BUFOUT; α initialize crosshairs;
DOZOOM(RZFCTR,ZSET);
RISHOW;LOCLOP(RCRSX,RCRSY,POSSET); α do crosshairs until satisfied;
End "do Right image crosshair adjustment"
ELSE
Begin "do Left image crosshair adjustment"
DOING←LEFT;SELECT(LCH);
LZX←(GRNLEFT+LCRSX-256)*LZMULT+256;
LZY←(GRNBOT+LCRSY-256)*LZMULT+256;
GSHOW_CURSOR(CURSNUM, IF CURBLINK THEN CURSNUM ELSE 0);
CRSHRS(0,0);BUFOUT; α initialize crosshairs;
DOZOOM(LZFCTR,ZSET);
LISHOW;LOCLOP(LCRSX,LCRSY,POSSET); α do until satisfied;
End "do Left image crosshair adjustment";
CTLV; α echo back on;
RETURN(POSSET);
End "fiddling with crosshairs";
INTEGER PROCEDURE ALGMNT;
Begin "Do alignment of n points"
INTEGER I;
FOR I ← 1 THRU MAXPTS DO
Begin
DOING←LEFT;STARTLOC; α Displaying Left screen here;
DOING←RIGHT;STARTLOC; α Displaying Right screen false here;
IF(AD(GRIGHT)) THEN DONE; α Adjust RIGHT crosshairs;
SRX[I]←XCOORD←RCRSX;SRY[I]←YCOORD←RPCLGT-RCRSY; α coords of Right picture;
DOING←LEFT; α Force left viewing reload;
LCRSX←RCRSX;LCRSY←RCRSY; α Start left image crosshairs at right's position;
AD(GLEFT); α Adjust LEFT crosshairs;
SLX[I]←XCOORD←LCRSX;SLY[I]←YCOORD←LPCLGT-LCRSY; α coords of Left picture;
PRINT("[",I,"]");
End;
NUMPTS←I-1;
End "Do alignment of n points";
α ADJPIC procedure;
GETPFL(PICL,PICARRAY[0]); α bring in Left picture;
PRINT("Left image:[",PICARRAY[PCLN]," lines * ",PICARRAY[LNBY],
" bytes * ",PICARRAY[BYBI]," bits]"&crlf);
GRNINI;GSETUP;
LSETUP;LPICUP; α Setup picture parameters;
GETPFL(PICR,PICARRAY[0]); α bring in Right picture;
PRINT("Right image:[",PICARRAY[PCLN]," lines * ",PICARRAY[LNBY],
" bytes * ",PICARRAY[BYBI]," bits]"&crlf);
RSETUP;RPICUP;
OLDPTS←ASK("Use points from a file");
IF ¬OLDPTS THEN
Begin "getpts"
IF DDVDIR THEN SHOW(VIDSCR,-1) ELSE OUTSTR("*Ready*"&crlf);
ALGMNT;
TZSCAL←ZSCAL;ZSCAL←-1;POSSET←FALSE;
DOING←RIGHT;STARTLOC;DOING←LEFT;STARTLOC; α reset screens;
GSHOW_CURSOR(0,0);BUFOUT; α turn off cursor;
ZSCAL←TZSCAL;
IF DDVDIR THEN SHOW(-1,-1); α back to user's screen;
End "getpts"
ELSE
Begin "oldpts"
FILECHAN←GETCHAN;OPEN(FILECHAN,"DSK",0,1,1,10000,DPBRCHAR,DPEOF);
DO Begin
OUTSTR("Datapoint file: ");
LOOKUP(FILECHAN,INCHWL,DPFLAG);
IF DPFLAG≠0 THEN PRINT("Invalid filename, try again",CRLF);
End UNTIL DPFLAG=0;
NUMPTS←INTIN(FILECHAN);
FOR I←1 THRU numpts DO
Begin "ptsin"
SLX[I]←REALIN(FILECHAN);SLY[I]←REALIN(FILECHAN);
SRX[I]←REALIN(FILECHAN);SRY[I]←REALIN(FILECHAN);
End "ptsin";
End "oldpts";
IF ASK("
Improve correspondence estimates") THEN IMPROVE; α improve estimates;
End "Lining up two pairs of points for ROTCROP";
INTERNAL PROCEDURE CHOSPTS(REFERENCE REAL ARRAY LX,LY,RX,RY;
REFERENCE INTEGER N,LP,WP,PBTS;
REFERENCE STRING FNM1,FNM2;
BOOLEAN GRINRUN);
Begin "pick corresponding points on two images"
α Main program;
OUTSTR("
This program works with you to select corresponding image points for use
in determining the epipolar transformations taking both images into a
common collinear epipolar frame. You choose point pairs in the stereo
imagery using cursor manipulation keys (? will list them).
");
GETO(LCH,"Left image channel: ",0);
GETO(RCH,"Right image channel: ",1);
CONRAC←ASK("All white on the Conrac");
IF CONRAC THEN
Begin
DDVDIR←FALSE;PORT←3;
L[1]←LCH;L[2]←LCH;L[3]←LCH;L[4]←1;L[5]←2;L[6]←3; α initialize port switchings;
R[1]←RCH;R[2]←RCH;R[3]←RCH;R[4]←1;R[5]←2;R[6]←3; α initialize port switchings;
End
ELSE
Begin "Not conrac"
IF (DDVDIR←ASK("DD(y) or direct port(n)")) THEN PORT←VIDEOCHAN
ELSE GETO(PORT," Output port: ",5);
L[1]←R[1]←0;L[2]←R[2]←1;L[3]←R[3]←2; α initialize port switchings;
L[4]←R[4]←1;L[5]←R[5]←2;L[6]←R[6]←3;
L[PORT]←LCH;R[PORT]←RCH; α these are to be seen;
End "Not conrac";
SETFORMAT(3,0); α not very high precision is default;
IF GRINRUN THEN
Begin "doG pts"
α IF ¬(MIDCURSOR←ASK(" Mid pixel cursor?:")) THEN CINCR←0;
α CURBLINK←ASK(" Blinking cursor?:");
MIDCURSOR←TRUE;CURBLINK←FALSE;
DO OUTSTR("Left picture:") UNTIL (LSIZE←PFLDIM(PICL←INCHWL))>0;
DO OUTSTR("Right picture:") UNTIL (RSIZE←PFLDIM(PICR←INCHWL))>0;
ADJPIC; α Align pictures;
OUTSTR("Chosen points are:"&crlf);
FOR I←1 THRU numpts DO
PRINT("(",cvf(LX[I]←SLX[I]),",",cvf(LY[I]←SLY[I]),")/(",
cvf(RX[I]←SRX[I]),",",cvf(RY[I]←SRY[I]),")",CRLF);
IF ASK("Save chosen points") THEN
Begin "Disksave"
OUTSTR("Datapoint Filename:");
SETPRINT(INCHWL,"F");
PRINT(NUMPTS,CRLF);
FOR I←1 THRU numpts DO
PRINT(cvf(LX[I]←SLX[I]),",",cvf(LY[I]←SLY[I]),",",
cvf(RX[I]←SRX[I]),",",cvf(RY[I]←SRY[I]),CRLF);
SETPRINT(NULL,"T");
End "Disksave";
N←numpts;
End "doG pts"
ELSE
Begin "noG"
GRNINI;GSETUP;
GETD(PICLGT,"Image height: ",256);
GETD(PICWID,"Image width: ",256);
GRNLEFT←(512-PICWID)/2;
GRNTOP←255+PICLGT/2;
GRNBOT←GRNTOP-PICLGT+1;
End "noG";
LP←PICLGT←LPCLGT;WP←PICWID←LPCWID;FNM1←PICL;FNM2←PICR;PBTS←BITS;
End "pick corresponding points on two images";
PROCEDURE SETCHAN(INTEGER SCHAN);
Begin "setchan"
OVERLAY←(IF SCHAN=LCH THEN LOVERLAY ELSE ROVERLAY);
CHAN←SCHAN;
SELECT(OVERLAY+8); α select overlay channel;
IF CONRAC THEN α if CONRAC then one overlay is white, the other;
Begin α misses a color;
GSHOW(CHAN);
IFVCOUTPUT(0,0,0,0,(1 LSH OVERLAY));α set up overlay for lines;
IFVCOUTPUT(1,0,0,0,(1 LSH OVERLAY));α set up overlay for lines;
End
ELSE
IF ¬TWOSCRS THEN
Begin
GSHOW(CHAN);
IFVCOUTPUT(DRIVER,0,0,0,(1 LSH OVERLAY));α set up overlay for lines;
End;
BUFOUT;
END "setchan";
INTERNAL PROCEDURE SETLEFT; SETCHAN(LCH);
INTERNAL PROCEDURE SETRIGHT; SETCHAN(RCH);
INTERNAL PROCEDURE OVERLINE(INTEGER X1,Y1,X2,Y2);
Begin "draw line"
X1←X1+GRNLEFT;Y1←(PICLGT-Y1-1)+GRNBOT;
X2←X2+GRNLEFT;Y2←(PICLGT-Y2-1)+GRNBOT;
DRAWGRNLINE(X1,Y1,X2,Y2,'7777); α put up the line;
BUFOUT;
End "draw line";
INTERNAL PROCEDURE INITOVERLAY;
Begin "init overlay"
DRIVER ←(IF PORT≤3 THEN 0 ELSE 1);
ROVERLAY←3;
LOVERLAY←(IF PORT > 3 THEN (PORT-4) ELSE (3-PORT));
ERASEG(LOVERLAY+8); α clear the overlays to start;
ERASEG(ROVERLAY+8);
TWOSCRS←FALSE;
IF ¬CONRAC THEN
Begin
IF PORT>3 THEN
Begin
IF (TWOSCRS←ASK("Two screens")) THEN
Begin "set twoscreens"
DD[1]←0;DD[2]←1;DD[3]←0;DD[DDPORT]←RCH;
IFVCOUTPUT(0,0,0,0,(1 LSH ROVERLAY));α RCH to 0;
IFVCOUTPUT(1,0,0,0,(1 LSH LOVERLAY));α LCH to 1;
SWITCHCHAN(0,DD[1],DD[2],DD[3]);
SWITCHCHAN(1,L[4],L[5],L[6]);
SHOW(VIDSCR,-1); α show the DDPORT on user's screen;
End "set twoscreens";
End;
End;
BUFOUT;
End "init overlay";
INTERNAL PROCEDURE FINIOVERLAY;
Begin "fini overlay"
SwitchChan(0,0,1,2);
SwitchChan(1,1,2,3);
IFVCOUTPUT(0,0,0,0,0); α set up no overlays;
IFVCOUTPUT(1,0,0,0,0); α set up no overlays;
BUFOUT;
End "fini overlay";
INTERNAL PROCEDURE TESTOVERS;
Begin "testovers"
Integer port,overlay,driver;
GETD(DRIVER,"Video board to test (0,1):",0);
SWITCHCHAN(0,0,1,2);
SWITCHCHAN(1,1,2,3);
ERASEG(0+8); α clear the overlays to start;
ERASEG(1+8);
ERASEG(2+8);
ERASEG(3+8);
IFVCOUTPUT(DRIVER,0,0,0,'17); α all overlays;
FOR OVERLAY ← 0 THRU 3 DO
Begin "numsup"
SELECT(OVERLAY+8); α select overlay channel;
GrnString(255,255,CVS(OVERLAY));
End "numsup";
BUFOUT;
FOR PORT←1 THRU 3 DO
BEGIN
ASK("Port ready");
IFVCOUTPUT(DRIVER,0,0,0,'17); α all overlays;
print("port:",port," all overlays",crlf);
FOR OVERLAY←0 THRU 3 DO
Begin "slipin"
INCHRW;
IFVCOUTPUT(DRIVER,0,0,0,(1 LSH OVERLAY));
BUFOUT;
print("Port:",port," overlay:",overlay,crlf);
End "slipin";
END;
IFVCOUTPUT(DRIVER,0,0,0,0); α no overlays;
ERASEG(0+8);ERASEG(1+8);ERASEG(2+8);ERASEG(3+8);BUFOUT;
End "testovers";
END "CHOSPTS";